Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/password.fr_/password.fr

Text File | 1995-07-06 | 6KB | 200 lines

VERSION 4.00
Begin VB.Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Passworder"
   ClientHeight    =   2760
   ClientLeft      =   1080
   ClientTop       =   1515
   ClientWidth     =   4980
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   3165
   Left            =   1020
   LinkTopic       =   "Form1"
   ScaleHeight     =   2760
   ScaleWidth      =   4980
   Top             =   1170
   Width           =   5100
   Begin VB.CommandButton cmdClose
      Caption         =   "Cl&ose"
      Height          =   555
      Left            =   2520
      TabIndex        =   7
      Top             =   1920
      Width           =   1755
   End
   Begin VB.CommandButton cmdChangePwd
      Caption         =   "&Change Password"
      Height          =   555
      Left            =   480
      TabIndex        =   6
      Top             =   1920
      Width           =   1755
   End
   Begin VB.ComboBox cboUsers
      Height          =   300
      Left            =   2160
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   360
      Width           =   2115
   End
   Begin VB.TextBox txtVerify
      Height          =   285
      Left            =   2160
      TabIndex        =   4
      Top             =   1320
      Width           =   2115
   End
   Begin VB.TextBox txtNew
      Height          =   285
      Left            =   2160
      TabIndex        =   3
      Top             =   840
      Width           =   2115
   End
   Begin VB.Label Label4
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Retype to verify:"
      Height          =   195
      Left            =   540
      TabIndex        =   2
      Top             =   1380
      Width           =   1425
   End
   Begin VB.Label Label3
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&New password:"
      Height          =   195
      Left            =   630
      TabIndex        =   1
      Top             =   900
      Width           =   1305
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&User:"
      Height          =   195
      Left            =   1410
      TabIndex        =   0
      Top             =   420
      Width           =   465
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

#If Win32 Then
    Private Declare Function GetWindowsDirectory Lib "Kernel32" _
        Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
        ByVal nSize As Long) As Long
#Else
    Private Declare Function GetWindowsDirectory Lib "Kernel" _
        (ByVal lpBuffer As String, _
        ByVal nSize As Integer) As Integer
#End If

Private db As DATABASE

Private Sub Form_Load()
    Dim myUser As String, myPass As String
    Dim i As Integer
    Dim winDir As String * 128
    Dim dirLen As Integer
    Dim dbName As String

    ' On Error GoTo LoadError

    ' Get the Windows directory and set the INI path.
    dirLen = GetWindowsDirectory(winDir, 128)
    If dirLen = 0 Then Error 32767
    DBEngine.IniPath = Left$(winDir, dirLen) & "\VBDBHT.INI"

    ' Set the user and passwords for initial login.
    myUser = "Admin"
    myPass = "theboss"
    DBEngine.DefaultUser = myUser
    DBEngine.DefaultPassword = myPass

    ' Get the database name and open the database.
    dbName = DataPath() & "\CHAPTER.09\ORDERS.MDB" ' DataPath() is in READINI.BAS
    Set db = DBEngine.Workspaces(0).OpenDatabase(dbName)

    ' Fill the list box on the form.
    FillUserList

Exit Sub

LoadError:
    MsgBox Err.Description, vbCritical
End

End Sub

Sub FillUserList()
    Dim usr As User

    For Each usr In DBEngine.Workspaces(0).Users
        If UCase$(usr.Name) <> "CREATOR" And UCase$(usr.Name) <> "ENGINE" And UCase$(usr.Name) <> "ADMIN" Then
            cboUsers.AddItem usr.Name
        End If
    Next
End Sub

Private Sub cmdChangePwd_Click()
    Dim ws As Workspace

    On Error GoTo ChangeError

    If cboUsers.ListIndex = -1 Then Error 32765
    If txtNew = "" Then Error 32766
    If Len(txtNew) > 14 Then Error 32764
    If txtNew <> txtVerify Then Error 32767
    DBEngine.Workspaces(0).Users(cboUsers.TEXT).NewPassword "", txtNew
    MsgBox "Password changed for " & cboUsers.TEXT, vbInformation
    txtNew = ""
    txtVerify = ""
    cboUsers.ListIndex = -1
Exit Sub
ChangeError:
    Dim msg As String
    Select Case Err.Number
        Case 32764
            msg = "The password may not be longer than 14 characters"
            txtNew = ""
            txtVerify = ""
        Case 32765
            msg = "You have not selected a user"
        Case 32766
            msg = "You have not entered a new password"
        Case 32767
            msg = "The verify box does not match the new password box"
            txtNew = ""
            txtVerify = ""
        Case Else
            msg = Err.Description & " (" & Err.Number & ")"
    End Select
    MsgBox msg, vbExclamation
End Sub

Private Sub cmdClose_Click()
    End
End Sub